home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byte0887.arc / SZPAK.BNL < prev    next >
Text File  |  1987-05-11  |  7KB  |  209 lines
  1. % A Simple Compiler
  2. %
  3. % From Stan Szpakowicz, "Logic Grammars", BYTE, Aug. 1987
  4. % Written in Prolog using logic grammars
  5. %
  6. % Note: In order to execute this program, a Prolog interpreter
  7. % must support logic grammars, of definite clause grammars
  8. %
  9.  
  10. % === main program ===
  11. compile :-
  12.         set_gensym( "$lbl" ),  set_gensym( "$mem" ),
  13.         read_in( Chars ),                     % (skips initial white space)
  14.         lsym_list( LexSyms, Chars, [] ),      % lexical analysis
  15.         program( Tree, LexSyms, [] ),         % syntactic analysis
  16.         interm_code( Tree, Code, [] ),        % code generation
  17.         write_out( Code ),  !.
  18. compile  :-  write( 'Sorry' ),  nl.
  19.  
  20. % read in a sequence of characters terminated by a #
  21. read_in( Chars )  :-  get( Ch ), read_in( Ch, Chars ).
  22.  
  23. read_in( 35, [] )  :-  !.       % #
  24. read_in( Ch, [Ch | Chars] )  :-  get0( Ch1 ),  read_in( Ch1, Chars ).
  25.  
  26. % print the generated code one instruction per line
  27. write_out( [] ).
  28. write_out( [Instr | Instrs] )  :-
  29.         write( Instr ),  nl,  write_out( Instrs ).
  30.  
  31. % === scanner ===
  32. % list of lexical symbols
  33. lsym_list( [LexSym | LexSyms] )  -->
  34.         lsym( LexSym ),  !,  opt_space,  lsym_list( LexSyms ).
  35. lsym_list( [] )  -->  [].
  36.  
  37. % one lexical symbol (input tokens are ASCII codes)
  38. lsym( IdOrKwd )  -->   letter( L ),  alphanums( Ls ),
  39.                        { name( Nm, [L | Ls] ) },  { wrap_name( Nm, IdOrKwd ) }.
  40. lsym( num( N ) )  -->   digit( D ),  digits( Ds ),
  41.                         { name( N, [D | Ds] ) }.
  42. lsym( := )  --> [58], [61].       % colon, equals
  43. lsym( S )  -->  [Ch],  { name( S, [Ch] ) }.
  44.  
  45. % optional white space between lexical symbols
  46. opt_space  -->  white_space,  !,  opt_space.
  47. opt_space  -->  [].
  48.  
  49. % recognizing classes of ASCII codes 
  50. letter( L )  -->  [L],  { is_letter( L ) }.
  51. digit( D )  -->  [D],  { is_digit( D ) }.
  52. white_space  -->  [Ch],  { is_white_space( Ch ) }.
  53.  
  54. is_letter( Ch )  :-  65 =< Ch,  Ch =< 90.
  55. is_letter( Ch )  :-  97 =< Ch,  Ch =< 122.
  56.  
  57. is_digit( Ch )  :-  48 =< Ch,  Ch =< 57.
  58.  
  59. is_white_space( 32 ).   % blank space
  60. is_white_space( 13 ).   % new line (this would be 10 in Quintus Prolog)
  61. is_white_space( 9 ).    % tab
  62.  
  63. % keywords and identifiers
  64. alphanums( [L | Ls] )  -->  letter( L ),  alphanums( Ls ).
  65. alphanums( [L | Ls] )  -->  digit( L ),  alphanums( Ls ).
  66. alphanums( [] )  -->  [].
  67.  
  68. wrap_name( Nm, Nm )  :-  is_keyword( Nm ).
  69. wrap_name( Nm, id( Nm ) ).
  70.  
  71. % table of keywords
  72. is_keyword( if ).       is_keyword( then ).     is_keyword( fi ).
  73. is_keyword( while ).    is_keyword( do ).       is_keyword( od ).
  74. is_keyword( skip ).     is_keyword( not ).
  75.  
  76. % integers
  77. digits( [D | Ds] )  -->  digit( D ),  digits( Ds ).
  78. digits( [] )  -->  [].
  79.  
  80. % === parser ===
  81. program( s( Stmt, Stmts) )  -->
  82.         statement( Stmt ),  [';'],
  83.         statements( Stmts ).
  84.  
  85. statements( s( Stmt, Stmts) )  -->
  86.         statement( Stmt ),  [';'],  !,
  87.         statements( Stmts ).
  88. statements( skip )  -->  [].
  89. % a sequence of statements is represented as a nested term,
  90. % for example s( Stmt1, s( Stmt2, s( Stmt3, skip ) ) ),
  91. % where Stmt1, Stmt2, Stmt3 represent individual statements 
  92.  
  93. statement( skip )  -->  [skip].
  94. statement( let( V, E ) )  -->  [id( V )],  [:=],  expr( E ).
  95. statement( if( C, Stmts ) )  -->
  96.         [if],  condition( C ),  [then],  statements( Stmts ),  [fi].
  97. statement( while( C, Stmts ) )  -->
  98.         [while],  condition( C ),  [do],  statements( Stmts ),  [od].
  99.  
  100. condition( not( C ) )  -->  [not],  relation( C ).
  101. condition( C )  -->  relation( C ).
  102.  
  103. relation( cond( Op, E1, E2 ) )  -->  expr( E1),  comp_op( Op ),  expr( E2 ).
  104.  
  105. comp_op( '=' )  -->  ['='].
  106. comp_op( '<' )  -->  ['<'].
  107.  
  108. expr( E )  -->  add_expr( AE ),  rest_expr( AE, E ).
  109.  
  110. rest_expr( AE1, E )  -->
  111.         ['+'],  add_expr( AE2 ),  rest_expr( e( '+', AE1, AE2 ), E ).
  112. rest_expr( AE1, E )  -->
  113.         ['-'],  add_expr( AE2 ),  rest_expr( e( '-', AE1, AE2 ), E ).
  114. rest_expr( E, E )  -->  [].
  115.  
  116. add_expr( AE )  -->  mult_expr( ME ),  rest_add_expr( ME, AE ).
  117.  
  118. rest_add_expr( ME1, AE )  -->
  119.         ['*'],  mult_expr( ME2 ),  rest_add_expr( e( '*', ME1, ME2 ), AE ).
  120. rest_add_expr( ME1, AE )  -->
  121.         ['/'],  mult_expr( ME2 ),  rest_add_expr( e( '/', ME1, ME2 ), AE ).
  122. rest_add_expr( E, E )  -->  [].
  123.  
  124. mult_expr( var( V ) )  -->  [id( V )].
  125. mult_expr( num( N ) )  -->  [num( N )].
  126. mult_expr( E )  -->  ['('],  expr( E ),  [')'].
  127.  
  128. % === code generation ===
  129. % statements
  130. interm_code( s( Stmt, Stmts ) )  -->
  131.         interm_code( Stmt ),  interm_code( Stmts ).
  132. interm_code( skip )  -->  [].
  133. interm_code( let( V, E ) )  -->
  134.         expr_interm_code( E ),  [store( V )].
  135. interm_code( if( C, Stmts ) )  -->
  136.         { newlabel( L ) },
  137.         cond_interm_code( not( C ) ),
  138.         [jmp_cond( L )],
  139.         interm_code( Stmts ),
  140.         [label( L )].
  141. interm_code( while( C, Stmts ) )  -->
  142.         { newlabel( L1 ) },  { newlabel( L2 ) },
  143.         [label( L1 )],
  144.         cond_interm_code( not( C ) ),
  145.         [jmp_cond( L2 )],
  146.         interm_code( Stmts ),
  147.         [jmp( L1 )],  [label( L2 )].
  148.  
  149. % conditions
  150. cond_interm_code( not( not( C ) ) )  -->  cond_interm_code( C ).
  151. cond_interm_code( not( R ) )  -->
  152.         rel_interm_code( R ),  [flip].
  153.                     % flip: negate the contents of the condition register
  154. cond_interm_code( R )  -->
  155.         rel_interm_code( R ).
  156.  
  157. % relations
  158. rel_interm_code( cond( Op, E1, E2 ) )  -->
  159.         expr_interm_code( E2 ),  { newmemloc( M ) },  [store( M )],
  160.         expr_interm_code( E1 ),  [sub( M )],  tst_interm_code( Op ).
  161.  
  162. % set the condition register 
  163. tst_interm_code( '=' )  -->  [tst_zer].
  164. tst_interm_code( '<' )  -->  [tst_neg].
  165.  
  166. % expressions
  167. expr_interm_code( e( Op, E1, E2 ) )  -->
  168.         expr_interm_code( E2 ),  { newmemloc( M ) },  [store( M )],
  169.         expr_interm_code( E1 ),  eop_interm_code( Op, M ).
  170. expr_interm_code( var( V ) )  -->
  171.         [load( V )].
  172. % load a constant
  173. expr_interm_code( num( N ) )  -->
  174.         [loadc( N )].
  175.  
  176. eop_interm_code( '+', M )  -->  [add( M )].
  177. eop_interm_code( '-', M )  -->  [sub( M )].
  178. eop_interm_code( '*', M )  -->  [mul( M )].
  179. eop_interm_code( '/', M )  -->  [div( M )].
  180.  
  181. % auxiliaries
  182. newlabel( L ) :-
  183.         gensym( "$lbl", L ).
  184. newmemloc( M ) :-
  185.         gensym( "$mem", M ).
  186.  
  187. % === utilities ===
  188. % symbol generator (preset in the main program)
  189. set_gensym( Pref )  :-
  190.         retract( sym( Pref, _ ) ),  fail.
  191. set_gensym( Pref )  :-
  192.         assert( sym( Pref, 1 ) ).
  193.  
  194. gensym( Pref, Sym )  :-
  195.         retract( sym( Pref, Num ) ),
  196.         Num1 is Num + 1,
  197.         assert( sym( Pref, Num1 ) ),
  198.         glue( Pref, Num, Sym ).
  199.  
  200. glue( Pref, Num, Sym )  :-
  201.         name( Num, Digits ),  append( Pref, Digits, All ),
  202.         name( Sym, All ),  !.
  203.  
  204. % well, you can't have a program without append...
  205. append( [], Z, Z ).
  206. append( [A | X], Y, [A | Z] )  :-  append( X, Y, Z ).
  207.  
  208. % end of program
  209.